-----------------------------------------------------------------------------
--
-- Module      :  Data.Units.Instances
-- Copyright   :
-- License     :  AllRightsReserved
--
-- Maintainer  :  eduard.sergeev@gmail.com
-- Stability   :
-- Portability :
--
-- UNum and UFractional ('unitified' Num and Fractional) classes definitions
--
-----------------------------------------------------------------------------

{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, TypeOperators,
TypeFamilies, UndecidableInstances, FlexibleInstances, ViewPatterns  #-}


module Data.Units.Instances
(

  QNum(..),
  QFractional(..),
  QReal(..),
  QIntegral(..),
  QFloating(..),

  (:::)(Q),
  quantitify,
  scalar,
  (<:),
  (>|),

  even,odd,
  gcd,

) where

import qualified Prelude as P
import Data.Eq
import Data.Bool
import Data.Function
import Prelude (Show(..), Double, undefined)
import Data.Function (($), (.))
import Data.List ((++))
import Data.Functor
import Control.Applicative

import Data.TypeLevel.Class
import Data.Units.Class
import qualified Data.Units.Types as T


infixl 1 :::
newtype n ::: m = Q { extract :: n }

instance (Eq n) => Eq (n ::: m) where
    Q l == Q r = l == r 
    Q l /= Q r = l /= r 

instance (Show n, (T.ToCanonical (T.ToList m)) ~ c, Show c) => Show (n ::: m) where
    show n = show (extract n) ++ "<" ++ (if sm == "1" then "" else sm) ++ ">"
        where sm = show (undefined::c)

type family Swap (t :: * -> * -> *) a b :: *
type instance Swap t a b = t b a

instance QApplicative (:::) where
    qpure = Q
    Q f <***> Q n = Q (f n)

-- | Lifting of non-quantitified value into (any) quantitified one
quantitify :: n -> n ::: m
quantitify = Q

-- | Lifting of non-quantitified value into scalar (dimentionless) of the same value
scalar :: (P.Num n) => n -> n ::: T.U
scalar = quantitify


-- | Conversion of dimetioness number into unitified number of 'u' unity
infixl 9 <:
(<:) :: (P.Num n, QNum q n, QApplicative q) => n -> q n u  -> q n u
n <: _ = qpure n


-- | Restriction of 'u' to be of 'u'' unity
infixl 9 >|
(>|) :: (P.Num n, QNum q n, QApplicative q) => q n u -> q n u -> q n u 
u >| _ = u



-- * Instances for (:::) type 
   
-- * QNum instance
{-
type instance Plus u u = u 
type instance Minus u u = u 
type instance Multiply l r = T.Multiply l r 
type instance Negate u = u
type instance Abs u = u
type instance Signum u = T.U
type instance Integer = P.Integer
type instance FromInteger u = u
-}

instance (P.Num n) => QNum (:::) n where
    (+) = qlift2M (P.+)
    (-) = qlift2M (P.-)
    (*) = qlift2M (P.*)
    negate = (P.negate <*$*>)
    abs = (P.abs <*$*>)
    signum = (P.signum <*$*>)
    fromInteger = quantitify . P.fromInteger


-- * QFractional instances
--type instance Divide l r = T.Divide l r 

instance (P.Fractional n) => QFractional (:::) n where
    (/) = qlift2M (P./)
    recip = (P.recip <*$*>)
    fromRational = quantitify . P.fromRational


--type instance ToRational n = P.Rational

instance (P.Real n) => QReal (:::) n where
    toRational = (P.toRational <*$*>) 


-- * Integral instance

instance (P.Integral n) => QIntegral (:::) n where
    quot = qlift2M P.quot 
    rem = qlift2M P.rem
    div = qlift2M P.div
    mod = qlift2M P.mod
    quotRem (Q l) (Q r) = let (rq,rr) = P.quotRem l r in (qpure rq , qpure rr) 
    divMod (Q l) (Q r) = let (d,m) = P.divMod l r in (qpure d , qpure m)
    toInteger = (P.toInteger <*$*>)

{-
--gcd             :: (QIntegral q n) => a -> a -> a
gcd (extract -> 0) (extract -> 0)         =  P.error "Prelude.gcd: gcd 0 0 is undefined"
gcd x y         =  gcd' (abs x) (abs y)
                   where gcd' a (extract -> 0)  =  a
                         gcd' a b  =  gcd' b (a `rem` b)
-}


-- * QFloating instance
--type instance Sqrt u = T.SquareRoot u
--type instance Scalar = T.U

instance (P.Floating n) => QFloating (:::) n where
    pi = qpure P.pi
    exp = (P.exp <*$*>)
    log = (P.log <*$*>)     
    sqrt = (P.sqrt <*$*>)
    (**) = qlift2M (P.**)
    logBase = qlift2M P.logBase
    sin = (P.sin <*$*>)
    cos = (P.cos <*$*>)
    tan = (P.tan <*$*>)
    asin = (P.asin <*$*>)
    acos = (P.acos <*$*>)
    atan = (P.atan <*$*>)
    sinh = (P.sinh <*$*>)
    cosh = (P.cosh <*$*>)
    tanh = (P.tanh <*$*>)
    asinh = (P.asinh <*$*>)
    acosh = (P.acosh <*$*>)
    atanh = (P.atanh <*$*>)


-- * Numberic functions

--even, odd       :: (QIntegral q n, P.Num n, Eq (q n u)) => q n u -> Bool
--even n          =  n `rem` (quantitify 2) == quantitify 0
--odd             =  not . even

--subtract :: (QNum q n) => q n ul -> a n ur -> a 
--subtract = flip (-)



qlift2M f l r = qpure f <***> l <***> r
f <*$*> q = qpure f <***> q


